(in-package :lilu-apropos)

;;;
;;; interactive apropos
;;;

(defparameter *command-table-options*
  '((:command-table-name-regex :regex "")
    (:command-table-package-name-regex :regex "")))

(defclass command-table-iapropos (iapropos)
  ()
  (:default-initargs
   :options *command-table-options*
   :sorting-symbol-p t
   :remove-duplicate-p nil
   :obj->symbol-fn #'clim:command-table-name
   :match-object-fn #'%command-table-iapropos-match-command-tables-p))

(defgeneric command-table-iapropos-matched-command-tables (command-table-iapropos)
  (:method  ((iapropos command-table-iapropos))
    (with-slots (cached-matched-objects) iapropos
      cached-matched-objects)))

(defun command-table-iapropos-set-option-values (iapropos &rest args
                                                 &key reset-p command-table-name-regex
                                                   command-table-package-name-regex)
  (declare (ignore command-table-name-regex command-table-package-name-regex))
  (apply #'iapropos-set-option-values iapropos :reset-p reset-p args))

(defmethod iapropos-update-search ((iapropos command-table-iapropos) changes)
  (iapropos-maching-objects iapropos
                            (alexandria:hash-table-values climi::*command-tables*)))

(defun %command-table-iapropos-match-command-tables-p (iapropos command-table)
  (with-slots (cached-regexp-scanners option-values) iapropos
    (and
     command-table
     #+nil(symbol-package (clim:command-table-name command-table))
     (when-option-regex (:command-table-name-regex cached-regexp-scanners)
       (cl-ppcre:scan scanner (string (clim:command-table-name command-table))))
     (when-option-regex (:command-table-package-name-regex cached-regexp-scanners)
       (if (symbol-package (clim:command-table-name command-table))
           (cl-ppcre:scan scanner (string (package-name (symbol-package (clim:command-table-name command-table)))))
           nil)))))


(defmethod iapropos-describe-object ((iapropos command-table-iapropos) command-table)
  (append
   (list :name (clim:command-table-name command-table)
         :inherit-from (mapcar #'clim:command-table-name
                               (clim:command-table-inherit-from command-table))
         :standard-command-table (closer-mop:subclassp (class-of command-table)
                                                       'clim:standard-command-table))
   (when (closer-mop:subclassp (class-of command-table) 'clim:standard-command-table)
     (list :commands (alexandria:hash-table-keys (climi::commands command-table))
           ;;:menu (slot-value command-table 'climi::menu)
           :command-line-names (alexandria:hash-table-keys
                                 (climi::command-line-names command-table))))))
